home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / MCL Networking / Events / EVENT.LISP
Encoding:
Text File  |  1990-08-31  |  2.1 KB  |  58 lines  |  [TEXT/CCL ]
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;; Copyright 1987, 1988, 1989, 1990 by Ruben Kleiman for Apple Computer, Inc.
  3. ;;; Advanced Technology Group
  4. ;;;
  5.  
  6. ;;;
  7. ;;; This file allows any function to be part of the eventhook
  8. ;;;
  9.  
  10. (in-package :event :use '(lisp system ccl))
  11.  
  12. (export '(add-eventhook remove-eventhook is-eventhook))
  13.  
  14. (defvar *fast-eventhooks* ()
  15.   "Holds forms to be evaluated at interrupt level")
  16.  
  17. (defvar *delayed-eventhooks* ()
  18.   "Holds forms to be frequently enqueued for evaluation at the lisp top level")
  19.  
  20. ;;; Two types of forms may be hooked: (1) an eval-enqueue form (type :¨SLOW), or (2) a
  21. ;;; real-time hook (type :FAST).  These get executed at the top-level or at event
  22. ;;; processing time, respectively.  The latter kind of hook must be efficient.
  23. (defun add-eventhook (form &optional (type :fast))
  24.   "To add a periodically executed background form"
  25.   (without-interrupts
  26.    (if (eql type :fast)
  27.      (push form *fast-eventhooks*)
  28.      (push form *delayed-eventhooks*))
  29.    (unless *eventhook*
  30.      (setq *eventhook* 'eventhook-monitor))))
  31.  
  32. ;;; Should probably be without-interrupts, but the packages mess up in 1.2d10
  33. (defun remove-eventhook (form &optional (type :fast))
  34.   "To remove a periodically executed background form"
  35.   (without-interrupts
  36.    (if (eql type :fast)
  37.      (setq *fast-eventhooks* (delete form *fast-eventhooks* :test #'equal))
  38.      (setq *delayed-eventhooks* (delete form *delayed-eventhooks* :test #'equal)))
  39.    (unless (or *fast-eventhooks*
  40.                *delayed-eventhooks*)
  41.      (setq *eventhook* nil))))
  42.  
  43. (defun is-eventhook (form)
  44.   "Is this form being periodically executed in the background?"
  45.   (without-interrupts
  46.    (or (member form *fast-eventhooks* :test #'equal)
  47.        (member form *delayed-eventhooks* :test #'equal))))
  48.  
  49. (defun eventhook-monitor ()
  50.   "Periodically evals certain forms in the background"
  51.   (and *fast-eventhooks*
  52.        (dolist (h *fast-eventhooks*)
  53.          (eval h)))
  54.   (and *delayed-eventhooks*
  55.        (dolist (h *delayed-eventhooks*)
  56.          (eval-enqueue h))))
  57.  
  58. (provide :event)